perm filename FUNC.SAI[T,LCS] blob
sn#010332 filedate 1972-09-15 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00010 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 BEGIN "FUNC"
00004 00003 Procedures ERROR, BADFORM,GET_4,REL_4
00006 00004 Procedures FINDFN,MUSCAN,GRAPHER
00010 00005 INITIALIZE WORLD
00011 00006 Read in file
00016 00007 Get a function name to edit
00018 00008 Edit a function
00021 00009 Edit Loop
00026 00010 Finish up
00028 ENDMK
⊗;
BEGIN "FUNC"
REQUIRE "⊂⊃⊗⊗" DELIMITERS;
REQUIRE "DPYSUB.HDR" SOURCE_FILE;
REQUIRE "SAITRG.HDR[1,PDQ]" SOURCE_FILE;
COMMENT LET'S HEAR IT FOR SAIL'S DEFAULTS!;
LET NON_SIMPLE_PROCEDURE=PROCEDURE;
LET LONG_REAL=REAL;
LET LONG_INTEGER=INTEGER;
DEFINE PROCEDURE=⊂SIMPLE NON_SIMPLE_PROCEDURE⊃;
DEFINE REAL=⊂SHORT LONG_REAL⊃;
DEFINE INTEGER=⊂SHORT LONG_INTEGER⊃;
DEFINE CRLF=⊂'15&'12⊃,ALTMODE='175;
DEFINE MAXSIZE=10;
DEFINE SIZE_OF_NODE_4=MAXSIZE*20;
DEFINE MUSBRK=1,SEMI_BREAK=2,NOT_IGNORED=3,DELIMITERS=4,SEG_KLUDGE=5;
DEFINE GRFSIZ=512;
STRING FILE,ALPHANUMERIC,IGNORED,TMPSTR;
INTEGER FNMAX,I,DEBUGFLAG,JUNK,SCALED;
INTEGER FREE_4;
INTEGER INCHN,INBRK,INEOF,OUTCHN,OUTEOF;
LABEL FINISH;
STRING ARRAY FNNAME[1:MAXSIZE],SUBNAM[1:MAXSIZE];
INTEGER ARRAY FNHEAD[1:MAXSIZE],LINK_4[1:SIZE_OF_NODE_4];
REAL ARRAY NODE_4[1:SIZE_OF_NODE_4,1:4];
COMMENT Procedures ERROR, BADFORM,GET_4,REL_4;
PROCEDURE ERROR(STRING STR);
BEGIN;
TYPLOC(0,-400);
OUTSTR("
"&STR);
CALL(1,"EXIT");
END;
PROCEDURE BADFORM(STRING STR1,STR2);
ERROR("Bad file format --- expecting '"&STR1&"` and got '"&STR2&"`");
INTEGER PROCEDURE GET_4; Comment Get a node of 4 cells;
IF FREE_4 THEN BEGIN INTEGER TEMP;
TEMP←FREE_4;
FREE_4←LINK_4[FREE_4];
IF ¬FREE_4 THEN USERERR(1,1,"Warning, only one entry left at GET_4");
RETURN(TEMP);
END ELSE USERERR(0,0,"You lose, out of space at GET_4");
PROCEDURE REL_4(INTEGER NODE); Comment Release a node of 4 cells;
BEGIN "REL_5";
IF NODE≤0∨NODE>SIZE_OF_NODE_4 THEN
USERERR(0,0,"Attempt to release non-existant node at REL_4");
LINK_4[NODE]←FREE_4;
FREE_4←NODE;
END "REL_5";
COMMENT Procedures FINDFN,MUSCAN,GRAPHER;
INTEGER PROCEDURE FINDFN(STRING STR);
BEGIN "FINDFN"
INTEGER FNNUM;
FNNUM←1;
WHILE FNNUM≤FNMAX∧¬EQU(FNNAME[FNNUM],STR) DO FNNUM←FNNUM+1;
IF FNNUM>FNMAX THEN RETURN(0) ELSE RETURN(FNNUM);
END "FINDFN";
STRING PROCEDURE MUSCAN;
BEGIN STRING RESULT;
DO BEGIN IF INBRK='40∨(INBRK≥'11∧INBRK≤'15) THEN INBRK←0;
IF INBRK THEN BEGIN RESULT←INBRK;
INBRK←0;
END
ELSE IF INEOF THEN RESULT←INBRK←-1 ELSE RESULT←INPUT(INCHN,MUSBRK);
END UNTIL RESULT; COMMENT SAIL REALLY EATS IT!;
IF DEBUGFLAG THEN OUTSTR("|"&RESULT&"|");
RETURN(RESULT);
END;
NON_SIMPLE_PROCEDURE DISPSTR(STRING STR);
BEGIN INTEGER ARRAY DPYBUF[0:LENGTH(STR)%5+5];
EXTERNAL STRING PROCEDURE DPYSTR(STRING STR;INTEGER X);
COMMENT DPYSET(DPYBUF);
COMMENT DPYSTR(-512,460,STR);
COMMENT IF DPYTST≠1 THEN DPYOUT('17);
DPYSTR(STR,'710600020);
END;
NON_SIMPLE_PROCEDURE GRAPHER(REAL ARRAY F);
BEGIN "GRAPHER"
INTEGER ARRAY DPYBUF[0:2000];
INTEGER X,OLDY,SV1,SV2;
REAL X2;
DEFINE K=7;
DPYSET(DPYBUF);
IF ¬SCALED THEN BEGIN
GETFORMAT(SV1,SV2);
SETFORMAT(-4,1);
AIVECT(-GRFSIZ/2,GRFSIZ/2);
AVECT(-GRFSIZ/2,(OLDY←-GRFSIZ/2)-1); COMMENT #&@&&@##;
FOR X2←-1 STEP 0.1 UNTIL 1.2 DO BEGIN;
RVECT(-K,0);
RIVECT(K,(GRFSIZ/2*X2)-OLDY);
OLDY←(GRFSIZ/2)*X2;
END;
FOR X2←-1 STEP .5 UNTIL 1 DO BEGIN;
AIVECT(-66-GRFSIZ/2,X2*(GRFSIZ/2)-3);
DPYSST(CVF(X2));
END;
SETFORMAT(SV1,SV2);
AIVECT(GRFSIZ/2,0);
RVECT(-GRFSIZ,0);
IF DPYTST≠1 THEN BEGIN;
DPYOUT('15);
SCALED←TRUE;
DPYSET(DPYBUF);
END;
END
ELSE ACCPOG('15);
RIVECT(0,(GRFSIZ/2)*(OLDY←F[0]));
FOR X←0 STEP 1 UNTIL 511 DO BEGIN
RVECT(GRFSIZ/512,(GRFSIZ/2)*F[X]-OLDY);
OLDY←(GRFSIZ/2)*F[X];
END;
DPYOUT('16);
END "GRAPHER";
COMMENT INITIALIZE WORLD;
FOR I←1 STEP 1 UNTIL SIZE_OF_NODE_4 DO LINK_4[I]←I-1;
FREE_4←SIZE_OF_NODE_4; Comment Make a free list of 4 celled nodes;
ALPHANUMERIC←"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_";
IGNORED←'11&'12&'14&'15;
SETBREAK(MUSBRK,ALPHANUMERIC,IGNORED,"XSN");
SETBREAK(DELIMITERS,ALPHANUMERIC,IGNORED,"ISN");
SETBREAK(NOT_IGNORED,"",IGNORED,"XAN");
SETBREAK(SEMI_BREAK,";",IGNORED,"ISN");
SETBREAK(SEG_KLUDGE,"S",IGNORED&"0123456789.","IRN");
SCALED←FALSE;
SETFORMAT(10,5);
COMMENT Read in file;
OUTSTR("
This is the new version of FUNC.
Type file name: ");
FILE←INCHWL;
OPEN(INCHN←GETCHAN,"DSK",0,2,0,256,INBRK←0,INEOF←0);
LOOKUP(INCHN,FILE,INEOF);
IF DPYTST=1 THEN DDCLR;
IF INEOF THEN IF (INEOF LAND 7)≤3 THEN BEGIN "FILERR"
CASE INEOF LAND 7 OF BEGIN "CASED"
[0] OUTSTR("File not found, I'll assume you want to create it.
IF you don't then type 'EXIT`");
[1] ERROR("Illegal project-programmer name");
[2] ERROR("I'm sorry but that file is protected against you.");
[3] ERROR("Someone else is using that file")
END "CASED"
END "FILERR"
ELSE USERERR(0,0,"System is sick")
ELSE BEGIN "READIN"
STRING WRD;
WHILE EQU(WRD←MUSCAN,"COMMENT") DO BEGIN;
DO INPUT(INCHN,SEMI_BREAK) UNTIL INBRK=";";
INBRK←0;
END;
IF ¬EQU(WRD,"ARRAY") THEN BADFORM("ARRAY",WRD);
FOR FNMAX←1 STEP 1 UNTIL MAXSIZE DO BEGIN "ARRPART"
FNNAME[FNMAX]←MUSCAN;
SUBNAM[FNMAX]←"UNDEFINED";
FNHEAD[FNMAX]←0;
IF (TMPSTR←MUSCAN)≠"," THEN DONE;
END "ARRPART";
IF TMPSTR="," THEN ERROR("Too many functions in "&FILE)
ELSE IF TMPSTR≠"(" THEN BADFORM("(",INBRK);
IF ¬EQU(TMPSTR←INPUT(INCHN,SEMI_BREAK),"512)") THEN
BADFORM("512)",TMPSTR) ELSE INBRK←0;
DO BEGIN "READFN"
INTEGER FNNUM,NODE;
STRING THISFN,SUBR;
SUBR←MUSCAN;
IF INEOF THEN DONE;
IF (TMPSTR←MUSCAN)≠"(" THEN BADFORM("(",TMPSTR);
THISFN←MUSCAN;
IF (TMPSTR←MUSCAN)≠")" THEN BADFORM(")",TMPSTR);
IF ¬(FNNUM←FINDFN(THISFN)) THEN
ERROR("New function found too late:"&THISFN);
SUBNAM[FNNUM]←SUBR;
NODE←0;
DISPSTR("Defining "&THISFN&" with "&SUBR);
IF EQU(SUBR,"SYNTH") THEN
BEGIN "GET_SYNTH"
REAL NUM;
NUM←REALIN(INCHN);
IF NUM≠99.0 THEN ERROR("Bad SYNTH header");
WHILE (NUM←REALIN(INCHN))≠999.0 DO BEGIN
COMMENT CONSTRUCT A LIST OF PARAMETERS;
NODE←IF NODE THEN LINK_4[NODE]←GET_4
ELSE FNHEAD[FNNUM]←GET_4;
NODE_4[NODE,1]←NUM;
NODE_4[NODE,2]←REALIN(INCHN);
NODE_4[NODE,3]←REALIN(INCHN);
NODE_4[NODE,4]←REALIN(INCHN);
INPUT(INCHN,NOT_IGNORED);
IF DEBUGFLAG THEN OUTSTR(CVS(NUM)&'11);
END;
END "GET_SYNTH" ELSE IF EQU(SUBR,"SEG") THEN
BEGIN "GET_SEG"
DO BEGIN
NODE←IF NODE THEN LINK_4[NODE]←GET_4
ELSE FNHEAD[FNNUM]←GET_4;
NODE_4[NODE,1]←REALIN(INCHN);
NODE_4[NODE,2]←REALIN(INCHN);
NODE_4[NODE,3]←0;
NODE_4[NODE,4]←0;
INPUT(INCHN,NOT_IGNORED);
IF DEBUGFLAG THEN OUTSTR(CVS(NODE_4[NODE,2])&" ");
END UNTIL NODE_4[NODE,2]≥100.0;
IF NODE_4[NODE,2]>500.0 THEN BEGIN;
FOR I←1 STEP 1 UNTIL 512 DO REALIN(INCHN);
COMMENT READ THE BAGBITING 101 KLUDGE!;
NODE_4[NODE,2]←101.0;
END;
LINK_4[NODE]←0;
END "GET_SEG"
ELSE ERROR("UNDEFINED FUNCTION: "&SUBR);
LINK_4[NODE]←0;
END "READFN" UNTIL INEOF;
END "READIN";
COMMENT Get a function name to edit;
WHILE TRUE DO BEGIN "MAIN_LOOP"
INTEGER FNNUM,I,J;
STRING THISFN;
WHILE TRUE DO BEGIN "GETFN"
STRING STR;
TYPLOC(-360,-400);
IF DPYTST=1 THEN DDCLR;
STR←"Functions in "&FILE&":";
FOR I←1 STEP 1 UNTIL FNMAX DO STR←STR&"
"&FNNAME[I]&" "&SUBNAM[I];
DISPSTR(STR&"
Type Function name or 'EXIT` to finish");
STR←""; COMMENT Release string space;
DO BEGIN;
OUTSTR("Name: ");
IF EQU(THISFN←INCHWL,"EXIT") THEN GO FINISH;
END UNTIL THISFN;
IF ¬(FNNUM←FINDFN(THISFN)) THEN FNNUM←FNMAX+1;
IF FNNUM>FNMAX THEN BEGIN "NEWFN";
IF FNNUM>MAXSIZE THEN BEGIN "FULL";
OUTSTR("I can't find that function and you have "&CVS(FNMAX)&" functions already.
");
DONE;
END "FULL";
IF DPYTST=1 THEN DDCLR;
DISPSTR("
Function "&FNNAME[FNNUM]&" not found. If you want to add it,
type either SYNTH or SEG, otherwise <return>.
");
FNNAME[FNNUM]←THISFN;
FNHEAD[FNNUM]←0;
DO OUTSTR(":") UNTIL ¬(SUBNAM[FNNUM]←INCHWL)∨
EQU(SUBNAM[FNNUM],"SYNTH")∨EQU(SUBNAM[FNNUM],"SEG");
IF ¬SUBNAM[FNNUM] THEN DONE ELSE FNMAX←FNNUM;
END "NEWFN";
COMMENT Edit a function;
BEGIN "EDITOR"
INTEGER NODE,COMCHAR,COUNT;
NON_SIMPLE_PROCEDURE UPDATE;
BEGIN "UPDATE"
INTEGER NODE;
STRING STR;
IF DPYTST=1 THEN DDCLR;
NODE←FNHEAD[FNNUM];
BEGIN "DISPLAY"
REAL ARRAY F[0:511];
IF EQU(SUBNAM[FNNUM],"SYNTH") THEN
WHILE NODE DO BEGIN "SYNTH"
INTEGER X;
REAL P1,P2,P3,P4;
P1←NODE_4[NODE,1]*(360/512);
P2←NODE_4[NODE,2];
P3←NODE_4[NODE,3];
P4←NODE_4[NODE,4];
NODE←LINK_4[NODE];
IF P4≥100.0 THEN BEGIN;
P4←P4-100.0;
FOR X←0 STEP 1 UNTIL 511 DO
F[X]←F[X]*P2*SIND(X*P1+P3)+P4;
END
ELSE FOR X←0 STEP 1 UNTIL 511 DO
F[X]←F[X]+P2*SIND(X*P1+P3)+P4;
END "SYNTH"
ELSE IF EQU(SUBNAM[FNNUM],"SEG") THEN BEGIN "SEG"
INTEGER LASTX;
REAL LASTY;
LASTX←0; LASTY←0;
WHILE NODE DO BEGIN "LOOP"
INTEGER X;
REAL K,P1,P2;
P1←NODE_4[NODE,1];
P2←NODE_4[NODE,2]*(512/100);
IF P2>511 THEN P2←511;
IF P2≠LASTX THEN K←(P1-LASTY)/(P2-LASTX) ELSE K←0;
IF LASTX≤P2 THEN
FOR X←LASTX STEP 1 UNTIL P2 DO
F[X]←LASTY+K*(X-LASTX);
LASTX←P2;
LASTY←P1;
NODE←LINK_4[NODE];
END "LOOP";
END "SEG" ELSE ERROR("UNDEFINED FUNCTION: "&SUBNAM[FNNUM]);
GRAPHER(F);
END "DISPLAY";
STR←"Editing "&FNNAME[FNNUM];
COUNT←0;
NODE←FNHEAD[FNNUM];
WHILE NODE DO BEGIN "MAKLST"
INTEGER I,J;
STR←STR&CRLF&CVS(COUNT←COUNT+1)&":";
I←5;
DO I←I-1 UNTIL NODE_4[NODE,I]∨I=2;
FOR J←1 STEP 1 UNTIL I DO
STR←STR&" "&CVF(NODE_4[NODE,J]);
NODE←LINK_4[NODE];
END "MAKLST";
DISPSTR(STR);
END "UPDATE";
COMMENT Edit Loop;
UPDATE;
DO BEGIN "E_LOOP"
INTEGER NUM,NUM2,I;
STRING COMMAND;
OUTSTR("⊗>");
COMMAND←INCHWL;
IF (COMCHAR←LOP(COMMAND))≥"a"∧COMCHAR≤"z" THEN
COMCHAR←COMCHAR-("Z"-"z");
NUM←IF COMMAND='40 THEN 0 ELSE INTSCAN(COMMAND,JUNK);
NUM2←IF COMMAND=":" THEN INTSCAN(COMMAND,JUNK) ELSE 0;
NODE←FNHEAD[FNNUM];
IF NUM<0∨NUM>COUNT∨NUM2<0∨NUM2>COUNT THEN
OUTSTR("ARG. OUT OF RANGE"&CRLF)
ELSE IF COMCHAR="I" THEN BEGIN "INSERT"
COMMENT Insert a line;
FOR I←2 STEP 1 UNTIL NUM DO
NODE←LINK_4[NODE];
WHILE TRUE DO BEGIN "I_LOOP"
INTEGER NEWNODE;
OUTSTR("I>");
IF ¬(COMMAND←INCHWL) THEN DONE;
NEWNODE←GET_4;
FOR I←1 STEP 1 UNTIL 4 DO
NODE_4[NEWNODE,I]←REALSCAN(COMMAND,JUNK);
IF NUM THEN BEGIN;
LINK_4[NEWNODE]←LINK_4[NODE];
NODE←LINK_4[NODE]←NEWNODE;
END
ELSE BEGIN;
LINK_4[NEWNODE]←NODE;
NUM←NODE←FNHEAD[FNNUM]←NEWNODE;
END;
UPDATE;
END "I_LOOP"
END "INSERT"
ELSE IF COMCHAR="D" THEN IF NUM THEN BEGIN "DELETE"
INTEGER OLDNODE;
IF ¬NUM2 THEN NUM2←NUM;
IF NUM≤NUM2 THEN BEGIN;
FOR I←3 STEP 1 UNTIL NUM DO
NODE←LINK_4[NODE];
FOR I←NUM STEP 1 UNTIL NUM2 DO BEGIN
IF NUM>1 THEN LINK_4[NODE]←LINK_4[OLDNODE←LINK_4[NODE]]
ELSE NODE←FNHEAD[FNNUM]←LINK_4[OLDNODE←NODE];
REL_4(OLDNODE);
END;
UPDATE;
END
ELSE OUTSTR("???"&CRLF);
END "DELETE" ELSE OUTSTR("???"&CRLF)
ELSE IF COMCHAR="Z" THEN
IF NUM THEN BEGIN "Z_EDIT"
INTEGER J;
STRING STR;
FOR I←2 STEP 1 UNTIL NUM DO
NODE←LINK_4[NODE];
I←5;
DO I←I-1 UNTIL NODE_4[NODE,I]∨I=2;
FOR J←1 STEP 1 UNTIL I DO
STR←STR&CVF(NODE_4[NODE,J]);
LODED(STR&CRLF);
IF STR←INCHWL THEN
FOR I←1 STEP 1 UNTIL 4 DO
NODE_4[NODE,I]←REALSCAN(STR,JUNK);
UPDATE;
END "Z_EDIT" ELSE OUTSTR("???"&CRLF)
ELSE IF COMCHAR="K" THEN BEGIN "KILL"
Comment Kill a function;
OUTSTR("Are you sure?");
IF INCHWL="Y" THEN BEGIN
FOR I←FNNUM STEP 1 UNTIL FNMAX-1 DO BEGIN
FNHEAD[I]←FNHEAD[I+1];
FNNAME[I]←FNNAME[I+1];
SUBNAM[I]←SUBNAM[I+1];
END;
FNMAX←FNMAX-1;
COMCHAR←"E";
END;
END
ELSE IF COMCHAR="V" THEN UPDATE
ELSE IF COMCHAR≠"E" THEN OUTSTR("???
<command> ::= <command letter>[<number>[:<number>]]
Commands: I-Insert, D-Delete, Z-Line edit, K-Delete Entire function
E-Exit editor, V-Restore display
");
END "E_LOOP" UNTIL COMCHAR="E";
DACPOG('15);
DACPOG('16);
END "EDITOR";
COMMENT Finish up;
END "GETFN";
END "MAIN_LOOP";
FINISH: IF ¬FNMAX THEN BEGIN;
OUTSTR("NOTHING TO SAVE ON FILE!"&CRLF);
WHILE TRUE DO CALL(1,"EXIT");
END;
CLOSE(INCHN);
DISPSTR("New file name or <return>:");
OPEN(OUTCHN←GETCHAN,"DSK",0,0,2,16,JUNK,OUTEOF←0);
DO BEGIN;
OUTSTR("File: ");
IF TMPSTR←INCHWL THEN FILE←TMPSTR;
ENTER(OUTCHN,FILE,OUTEOF);
IF OUTEOF THEN OUTSTR("Can't write:"&FILE&CRLF);
END UNTIL ¬OUTEOF;
IF DPYTST=1 THEN DDCLR ELSE DPYCLR;
OUT(OUTCHN,"ARRAY ");
FOR I←1 STEP 1 UNTIL FNMAX-1 DO
OUT(OUTCHN,FNNAME[I]&",");
OUT(OUTCHN,FNNAME[I]&(CRLF&"(512);"&CRLF));
FOR I←1 STEP 1 UNTIL FNMAX DO BEGIN "W_LOOP"
INTEGER NODE,K;
K←IF EQU(SUBNAM[I],"SEG") THEN 2 ELSE 4;
OUT(OUTCHN,SUBNAM[I]&"("&FNNAME[I]&");"&(IF K=4 THEN
" 99"&CRLF ELSE CRLF));
NODE←FNHEAD[I];
WHILE NODE DO BEGIN INTEGER J;
FOR J←1 STEP 1 UNTIL K DO OUT(OUTCHN,CVF(NODE_4[NODE,J]));
OUT(OUTCHN,CRLF);
NODE←LINK_4[NODE];
END;
IF K=4 THEN OUT(OUTCHN," 999.0 "&CRLF);
END "W_LOOP";
CLOSE(OUTCHN);
END "FUNC";